program ChristmasHat;
{$codepage utf8}
{$mode objfpc}
uses fdlib, fpimage, FPCanvas, FPImgCanv,
     FPReadPNG, FPReadBMP, fpreadjpeg, classes,
     fpwritebmp, fpwritepng, fpwritejpeg,
     sysutils;

{全局变量, global vars}
var
    img : TFPMemoryImage;
    picFile : string;
    threshold :longint;
    writer :TFPCustomImageWriter;
    outfile: string;

{初始化init}
procedure init();
begin
    if paramcount = 1 then
    begin
        picFile := paramstr(1);
        outfile := 'ChristmasHat';
        threshold := 0;
        img := TFPMemoryImage.Create(0,0);
    end
    else if paramcount = 2 then
    begin
        picFile := paramstr(1);
        outfile := paramstr(2);
        threshold := 0;
        img := TFPMemoryImage.Create(0,0);
    end
    else if paramcount = 3 then
    begin
        picFile := paramstr(1);
        outfile := paramstr(2);
        threshold := StrToInt(paramstr(3));
        img := TFPMemoryImage.Create(0,0);
    end
    else
    begin
        {writeln('example: ChristmasHat imagefilename [output] [threshold]');}
        {Halt(1);}
        write('picture name:');
        readln(picFile);
        write('output:');
        ReadLn(outfile);
        threshold := 0;
        img := TFPMemoryImage.Create(0,0);
    end;
end;

{endswith}
function EndsWith(const src: String;const Substr :String):Boolean;
var
I,I2: Integer;
begin
  Result := true;
  I2 := Length(SubStr);
  i:=length(src);
  if i<i2 then exit (false);
  
  for I := 1 to i2 do begin
  if not(src[length(src)-i2+i] = Substr[i]) then begin
        Result := false;
        exit;
    end;
    end;
end;

{ReadImage}
procedure ReadImage;
{$ifndef UseFile}var str : TStream;{$endif}
t:string;
reader : TFPCustomImageReader;
begin
    T := upcase (picFile);
    reader:=nil;
    if endsWith(t,'.BMP') then
    begin
      Reader := TFPReaderBMP.Create;
      if outfile='ChristmasHat' then outfile := outfile + '.bmp';
    end
    else if endswith(t,'.JPEG') or endswith(t,'.JPG') then
    begin
      Reader := TFPReaderJPEG.Create;
      if outfile='ChristmasHat' then outfile := outfile + '.jpg';
    end
    else if endswith(t,'.PNG') then
    begin
      Reader := TFPReaderPNG.Create;
      if outfile='ChristmasHat' then outfile := outfile + '.png';
    end
    else
      begin
      Writeln('Unknown file format : ',T);
      Halt(1);
    end;
    if assigned (reader) then
        begin img.LoadFromFile (picFile, Reader); Reader.Free; end
     else
    {$ifdef UseFile}
     img.LoadFromFile (picFile);
    {$else}
    if fileexists (picFile) then
    begin
        str := TFileStream.create (picFile,fmOpenRead);
        try
            img.loadFromStream (str);
        finally
            str.Free;
        end;
    end
    else
    begin
        writeln ('File ',picFile,' doesn''t exists!');
        Halt(1);
    end;
    {$endif}
end;

{createwriter}
procedure createwriter;
var
    t:string;
begin
    T := upcase (outfile);
    writer:=nil;
    if endsWith(t,'.BMP') then
    begin
      writer := TFPWriterBMP.Create;  
    end
    else if endswith(t,'.JPEG') or endswith(t,'.JPG') then
    begin
      writer := TFPWriterJpeg.Create;
    end
    else if endswith(t,'.PNG') then
    begin
      writer := TFPWriterPNG.create;
    end
    else
      begin
      //Writeln('Unknown outfile format : ',T);
      writer := TFPWriterJpeg.Create;
      outfile := outfile + '.jpg';
    end;    
end;

{DrawHat}
procedure DrawHat;
var
    height, width:integer;
    canvas : TFPCustomCanvas;
    graydata: array of byte;
    gray : longint;
    r,g,b,alpha:integer;
    color : TFPColor;
    n, i, x, y, size, cw, ch, h, w, iw,ih :longint;
    hatReader:TFPReaderBMP;
    hatimg:TFPCustomImage;
    maskimg:TFPCustomImage;
    MemImg:TFPCustomImage;
begin
    height := img.Height;
    width := img.Width;  
    SetLength(graydata,width * height);
    for y:= 1 to height do
    begin
        for x:=1 to width do
        begin
          color:=img.colors[x-1,y-1];
          alpha := (color.alpha and $ff00) shr 8;
          r := (color.red and $ff00) shr 8;
          g := (color.Green and $ff00) shr 8;
          b :=  (color.Blue and $ff00)shr 8;
          if alpha= 0 then
            graydata[(y-1)*width + x - 1]:=0
          else
          begin
            gray := trunc(R*0.3+G*0.59+B*0.11);
            graydata[(y-1)*width + x - 1]:= byte(gray);
          end;
        end;         
    end;
    //检测人脸
    fdlib_detectfaces(pointer(graydata),width,height,threshold);
    //返回人脸数
    n:=fdlib_getndetections();

    if n>0 then
    begin
        writeln('face(s): ',n);
        
        hatimg:=TFPMemoryImage.Create(0,0);
        maskimg:=TFPMemoryImage.Create(0,0);
        hatReader:=TFPReaderBMP.create;
        hatimg.LoadFromFile('./hat/hat.bmp',hatReader);
        hatReader.free;
        hatReader:=TFPReaderBMP.create;
        maskimg.LoadFromFile('./hat/mask.bmp',hatReader);
        hatReader.free;
        for i:=0 to n-1 do
        begin
          //得到第 i+1 张脸的坐标
          fdlib_getdetection(i,@x,@y,@size);
          //writeln(x,' ',y,' ',size);
          
          cw:=maskimg.Width* size div 450;
          ch:= maskimg.Height * cw div maskimg.Width;
          MemImg := TFPMemoryImage.create(cw *2,  ch);
          canvas := TFPImageCanvas.Create(MemImg);
          canvas.StretchDraw(0,0,cw,ch,maskimg);
          canvas.StretchDraw(cw,0,cw,ch,hatimg);
          canvas.free;
          
          for h:= 0 to ch-1 do
            for w:= 0 to cw - 1 do
              begin
                iw:=x - size div 2 + w - cw * 120 div maskimg.Width ;
                ih:=y - size div 2 - ch + h +10;

                if  (ih<0) or (ih>=img.Height) or 
                   (iw<0)  or (iw>=img.Width) then Continue;

                img.Colors[iw,ih]:= img.Colors[iw,ih] and MemImg[w,h];
                img.Colors[iw,ih]:= img.Colors[iw,ih] or MemImg[w+cw,h];

              end;

        end;{end for i 张脸}
        img.SaveToFile(outfile,writer);
        maskimg.Free;
        hatimg.Free;
    end
    else
        writeln('No face found!');

    SetLength(graydata,0);
    
    graydata:=nil;
end;

{clean}
procedure Clean;
begin
  writer.free;
  Img.Free;
end;

{main}
begin
    try
        //writeln ('Initing');
        Init;
        //writeln ('Reading image');
        ReadImage;
        // writeln ('create writer');
        createwriter;
      // writeln ('DrawHat');
       DrawHat;
       //writeln ('Clean up');
        Clean;
    except
        on e : exception do
            writeln ('Error: ',e.message);
    end;
end.